In this post, we use open data and R to look at how the geographic pattern of shootings in Baltimore may have changed in recent years.

The complete code need to get the data and reproduce these analyses is posted in the document, but the snippets are hidden unless you click them. For example, clicking code to the bottom-right of this sentence reveals the R script you would use to download all the data on shootings.

library(tidyverse)
library(scales)
library(knitr)
library(leaflet)
library(geojsonio)

bpd <- read_csv("https://raw.githubusercontent.com/peterphalen/ceasefire/master/BPD_Part_1_Victim_Based_Crime_Data.csv")

# subset to shootings or homicides with a firearm
bpd <- subset(bpd, Description == "SHOOTING" |
                (Description == "HOMICIDE" & Weapon == "FIREARM"))

bpd$CrimeDate <- as.Date(bpd$CrimeDate, format = "%m/%d/%Y")

# get polygons to draw neighborhood maps
nbds <- geojsonio::geojson_read("/Users/peterphalen/Documents/ceasefire/Neighborhoods.geojson", what = "sp")

We’re going to focus on monthly shooting counts in Baltimore as broken down by district.

Baltimore by district

Here is a map of all the districts. The holes in the map are neighborhoods that had zero observed shootings between 2012 and 2019.

bpd <- bpd[complete.cases(bpd$District, bpd$Neighborhood),]
# 23 neighborhoods have been coded in two different districts, presumably on accident
# we just pick the first district for now
district.index <- bpd %>% group_by(Neighborhood) %>% summarise(District = unique(District)[1])

get_district <- function(neighborhood){
  nbd <- as.character(neighborhood)
  if (nbd %in% district.index$Neighborhood){
  dist <- district.index[which(district.index$Neighborhood == nbd),]$District
  return(dist)
  }else{
  return(NA)
  }
}

nbds$district <- sapply(nbds$Name, get_district)

gg_color_hue <- function(n) {
  hues = seq(15, 375, length = n + 1)
  hcl(h = hues, l = 65, c = 100)[1:n]
}

labs <- unique(bpd$District)
pal.districts <- colorFactor(gg_color_hue(length(labs)), 
                             labs,
                             na.color="#00000000")

leaflet(nbds) %>% 
  addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(stroke=T,
              weight=1,
              color=~pal.districts(district),
              popup=ifelse(!is.na(nbds$district), paste0(nbds$Name," (",nbds$district,")"),"No shootings recorded in this area"),
              fillOpacity=.5) %>%
  addLegend("bottomright",title="Districts",colors=~pal.districts(labs),labels=~labs)

Shootings by neighborhood this year (2019)

Here are two maps of shootings this year (2019) to give a more fine-grained picture of where people are getting hurt or killed.

You can tap neighborhoods to see exact numbers.

It’s important to remember that all heatmaps of data are misleading, so you need to look at both maps to get an idea of what’s happening.

Raw counts

This map shows the raw count of murders in Baltimore in 2019 by neighborhood. It’s important to note that raw count maps will overestimate shootings in areas with many residents (like Frankford) and understimate shootings in areas with fewer residents (like Penn North).

bpd <- subset(bpd, !is.na(Neighborhood) & year(CrimeDate) >= 2019)

# count by neighobrhood
count <- bpd %>%
  group_by(Neighborhood) %>%
  summarise(total.count=n()) 

get_shooting_count <- function(neighborhood){
  nbd <- as.character(neighborhood)
  if(nbd %in% count$Neighborhood){
    count <- count[count$Neighborhood == nbd,]$total.count
    return(count)
  }
  if(!(nbd %in% count$Neighborhood)){
    return(0)
  }
}

nbds$count <- sapply(nbds$Name, get_shooting_count)

# draw legend
range.count <- range(nbds$count,na.rm=T)
labs <- c(0,5,10,15)
pal.crime <- colorNumeric(colorRamp(c('#ccccff', 'red')), labs)

leaflet(nbds) %>% 
  addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(stroke=T,
              weight=1,
              popup=paste0(nbds$Name,"<br/>Shootings: ",nbds$count),
              color=~pal.crime(count),
              fillOpacity=.5) %>%
  addLegend("bottomright",title="# of shootings (2019)",colors=~pal.crime(labs),labels=~labs)

Population-adjusted

This version adjusts by the population of each neighborhood. Be careful about the super bright red area: some neighborhoods have very few residents and so even a single shooting will make them look really dangerous even though they’re probably not. (You can tap neighborhoods to see the number of residents.)

Also, I think something may be going on with the “University of Maryland” neighborhood. It’s possible that some unsolved shootings where the victim was simply dropped off at the hospital were coded as having happened at the hospital.

#--------- population-adjusted --------------#
nbds$per1k <- nbds$count / nbds$Population * 1000
nbds$per1k <- round(nbds$per1k)
nbds$per1k <- ifelse(nbds$Population == 0, NA, nbds$per1k)
labs <- c(0,5,10,15,20)
pal.crime <- colorNumeric(colorRamp(c('#ccccff', 'red')), 
                          labs,
                          na.color = "#b2b2b2")

countlabel <- paste0(nbds$Name,"<br/>",nbds$count," shootings among ",nbds$Population," residents")
nbds$countlabel <- ifelse(nbds$Population == 0, paste0(nbds$Name,":<br/>","No residents"), countlabel)

leaflet(nbds) %>% #draw population-adjusted map,
                  #areas with 0 residents are greyed 
                  #out but can still be clicked
  addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(stroke=T,
              weight=1,
              popup=nbds$countlabel,
              color=~pal.crime(per1k),
              fillOpacity=.6) %>%
  addLegend("bottomright",title="Shootings per one</br>thousand residents</br>(2019)",colors=~pal.crime(labs),labels=~labs)